The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/phone5.src

Text File | 1991-10-19 | 4KB | 228 lines

%%HP: T(3)A(D)F(.);
@ PHONE, by Robert K. Brunner
DIR
  FILES
    DIR
      CARDS
        \<< RCWS 64
STWS RCLF ROT
          IF DUP
VTYPE -1 ==
          THEN DUP
{ } SWAP STO
          END CVIEW
STOF STWS
        \>>
    END
  CVIEW
    \<< DUP RCL DUP
SIZE ROT 1 DUP DUP
0 DUP DUP DUP \->
imax fnm i jmax j
ti tx txi txl
      \<< { "ADD"
"EDIT" "DEL" "FIND"
"SAVE" "QUIT" }
TMENU 11 SF 10 CF
        DO
          IF imax
          THEN
            IF 11
FS?C
            THEN
CLLCD DUP i cGET
'jmax' STO 'txl'
STO 'txi' STO 'tx'
STO DUP 1 DISP 'ti'
STO
            END tx
txi j txl ROT ROT
GET SWAP SUB 2 DISP
          ELSE
CLLCD "Empty file"
2 DISP 11 CF 0
'jmax' STO
          END -1
WAIT
          CASE DUP
25.1 ==
            THEN
              IF j
1 >
              THEN
'j' DECR DROP
              ELSE
eBEEP
              END
            END DUP
35.1 ==
            THEN
              IF j
5 + jmax <
              THEN
'j' INCR DROP
              ELSE
eBEEP
              END
            END DUP
34.1 ==
            THEN
              IF i
1 >
              THEN
1 'j' STO 'i' DECR
DROP 11 SF
              ELSE
eBEEP
              END
            END DUP
36.1 ==
            THEN
              IF i
imax <
              THEN
1 'j' STO 'i' INCR
DROP 11 SF
              ELSE
eBEEP
              END
            END DUP
11.1 ==
            THEN
DROP icADD 'i' STO
11 SF 'imax' INCR
            END DUP
12.1 ==
            THEN
              IF
imax
              THEN
DROP i icED 11 SF 0
              ELSE
eBEEP
              END
            END DUP
13.1 ==
            THEN
              IF
imax
              THEN
DROP i cDEL 1 'j'
STO 'imax' DECR
IF i <
THEN 'i' DECR
ELSE 0
END 11 SF
              ELSE
eBEEP
              END
            END DUP
14.1 ==
            THEN
              IF
imax
              THEN
DROP DUP "Title:" {
\Ga } INPUT cFIND
IF DUP imax <
THEN 1 +
END 'i' STO 11 SF 0
              ELSE
eBEEP
              END
            END DUP
15.1 ==
            THEN
DROP DUP fnm STO 0
            END DUP
16.1 ==
            THEN 10
SF
            END
          END DROP
        UNTIL 10
FS?
        END DROP 0
MENU
      \>>
    \>>
  icADD
    \<< DUP SIZE
"Title:" { \Ga }
INPUT DUP ":" + { \Ga
} INPUT \-> tit tx
      \<<
        IF NOT
        THEN 0
        ELSE DUP
tit cFIND
        END SWAP
OVER tit tx 2 \->LIST
cADD SWAP 1 +
      \>>
    \>>
  icED
    \<< \-> i
      \<< DUP i GET
DUP OBJ\-> DROP SWAP
":" + SWAP { \Ga } +
INPUT 2 SWAP PUT i
SWAP PUT
      \>>
    \>>
  eBEEP
    \<< 440 .1 BEEP
    \>>
  cGET
    \<< GET OBJ\-> DROP
SWAP ":" + SWAP DUP
DUP SIZE { 1 } \-> sz
txi
      \<<
        WHILE DUP
"
" POS DUP
        REPEAT SWAP
OVER " " REPL SWAP
1 + 'txi' SWAP STO+
        END DROP2
txi sz OVER SIZE
      \>>
    \>>
  cADD
    \<< \-> i new
      \<< OBJ\-> \-> n
        \<< new 'n'
INCR i - ROLLD n
\->LIST
        \>>
      \>>
    \>>
  cFIND
    \<< \-> str
      \<< { "" } SWAP
OBJ\-> DUP \-> n i
        \<<
          IF n
          THEN
            WHILE 1
GET str \>= i AND
            REPEAT
'i' DECR DROP
            END
          END i
DROPN i
        \>>
      \>>
    \>>
  cDEL
    \<< \-> i
      \<< OBJ\-> \-> n
        \<< n i - 1 +
ROLL DROP n 1 -
\->LIST
        \>>
      \>>
    \>>
END